home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / gnustuff / tos / smallt~1 / smallt~1.zoo / Object.st < prev    next >
Encoding:
Text File  |  1990-05-26  |  7.1 KB  |  321 lines
  1. "======================================================================
  2. |
  3. |   Object Method Definitions
  4. |
  5.  ======================================================================"
  6.  
  7.  
  8. "======================================================================
  9. |
  10. | Copyright (C) 1988, 1989, 1990 Free Software Foundation, Inc.
  11. | Written by Steve Byrne.
  12. |
  13. | This file is part of GNU Smalltalk.
  14. |
  15. | GNU Smalltalk is free software; you can redistribute it and/or modify it
  16. | under the terms of the GNU General Public License as published by the Free
  17. | Software Foundation; either version 1, or (at your option) any later version.
  18. | 
  19. | GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
  20. | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  21. | FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
  22. | details.
  23. | 
  24. | You should have received a copy of the GNU General Public License along with
  25. | GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
  26. | Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  
  27. |
  28.  ======================================================================"
  29.  
  30.  
  31. "
  32. |     Change Log
  33. | ============================================================================
  34. | Author       Date       Change 
  35. | sbyrne     26 Apr 90      Fixed shallowCopy to send new messages to the
  36. |                         object's class instead of the object itself.
  37. |
  38. | sbyrne     19 Sep 89      Converted to use real method categories.
  39. |
  40. | sbyrne      4 Jul 89      Added support for dependence relationships.
  41. |                         (-: how appropriate: July 4 is when the US declared
  42. |                             its INdependence from England :-)
  43. |
  44. | sbyrne     25 Apr 89      created.
  45. |
  46. "
  47.  
  48. Object comment: 
  49. 'I am the root of the Smalltalk class system. 
  50. All classes in the system are subclasses of me.' !
  51.  
  52.  
  53. !Object methodsFor: 'Relational operators'!
  54.  
  55. ~= anObject
  56.     ^(self = anObject) == false
  57. !
  58.  
  59. ~~ anObject
  60.     ^(self == anObject) == false 
  61. !
  62.  
  63. isNil
  64.     ^false
  65. !
  66.  
  67. notNil
  68.     ^true
  69. !!
  70.  
  71.  
  72.  
  73. !Object methodsFor: 'testing functionality'!
  74.  
  75. isKindOf: aClass
  76.     ^(self isMemberOf: aClass) or:
  77.         [ self class inheritsFrom: aClass ]
  78. !
  79.  
  80. isMemberOf: aClass
  81.     "Returns true if the receiver is an instance of the class 'aClass'"
  82.     ^self class == aClass
  83. !!
  84.  
  85.  
  86.  
  87. !Object methodsFor: 'copying'!
  88.  
  89. copy
  90.     ^self shallowCopy
  91. !
  92.  
  93. shallowCopy
  94.     | class aCopy |
  95.     class _ self class.
  96.     class isVariable
  97.         ifTrue: [ aCopy _ class basicNew: self basicSize ]
  98.     ifFalse: [ aCopy _ class basicNew ].
  99.  
  100.     " copy the instance variables (if any) "
  101.     1 to: class instSize do:
  102.         [ :i | aCopy instVarAt: i
  103.                  put: (self instVarAt: i) ].
  104.  
  105.     " copy the indexed variables (if any) "
  106.     class isVariable
  107.         ifTrue: [ 1 to: self basicSize do:
  108.                 [ :i | aCopy basicAt: i
  109.                          put: (self basicAt: i) ] ].
  110.     ^aCopy
  111. !
  112.  
  113. deepCopy
  114.     | class aCopy |
  115.     class _ self class.
  116.     class isVariable
  117.         ifTrue: [ aCopy _ class basicNew: self basicSize ]
  118.     ifFalse: [ aCopy _ class basicNew ].
  119.  
  120.     " copy the instance variables (if any) "
  121.     1 to: class instSize do:
  122.         [ :i | aCopy instVarAt: i
  123.                  put: (self instVarAt: i) deepCopy ].
  124.  
  125.     " copy the indexed variables (if any) "
  126.     class isVariable
  127.         ifTrue: [ 1 to: self basicSize do:
  128.                 [ :i | aCopy basicAt: i
  129.                          put: (self basicAt: i) deepCopy ] ].
  130.     ^aCopy
  131. !!
  132.  
  133.  
  134.  
  135. !Object methodsFor: 'class type methods'!
  136.  
  137. species
  138.     ^self class
  139. !
  140.  
  141. yourself
  142.     ^self
  143. !!
  144.  
  145.  
  146.  
  147. !Object methodsFor: 'dependents access'!
  148.  
  149. addDependent: anObject
  150.     | dependencies |
  151.     dependencies _ Smalltalk dependenciesAt: self.
  152.     dependencies isNil ifTrue:
  153.         [ dependencies _ Set new.
  154.       (Smalltalk at: #Dependencies) at: self put: dependencies ]
  155.     dependencies add: anObject
  156. !
  157.  
  158. removeDependent: anObject
  159.     | dependencies |
  160.     dependencies _ Smalltalk dependenciesAt: self.
  161.     dependencies notNil ifTrue:
  162.         [ dependencies remove: anObject ifAbsent: [] ]
  163. !
  164.  
  165. dependents
  166.     | dependencies |
  167.     dependencies _ Smalltalk dependenciesAt: self.
  168.     dependencies isNil ifTrue: [ dependencies _ Set new ].
  169.     ^dependencies asOrderedCollection
  170. !
  171.  
  172. release
  173.     " +++ I'm not sure that this is the right thing to do here; the book is
  174.       so vague... "
  175.     (Smalltalk at: #Dependencies) removeKey: self
  176. !!
  177.  
  178.  
  179.  
  180. !Object methodsFor: 'change and update'!
  181.  
  182. changed
  183.     self changed: self
  184. !
  185.  
  186. changed: aParameter
  187.     | dependencies |
  188.     dependencies _ Smalltalk dependenciesAt: self.
  189.     dependencies notNil ifTrue:
  190.         [ dependencies do:
  191.         [ :dependent | dependent update: aParameter ] ]
  192. !
  193.  
  194. update: aParameter
  195.     "Default behavior is to do nothing"
  196. !
  197.  
  198. broadcast: aSymbol
  199.     | dependencies |
  200.     dependencies _ Smalltalk dependenciesAt: self.
  201.     dependencies notNil ifTrue:
  202.         [ dependencies do:
  203.         [ :dependent | dependent perform: aSymbol ] ]
  204. !
  205.  
  206. broadcast: aSymbol with: anObject
  207.     | dependencies |
  208.     dependencies _ Smalltalk dependenciesAt: self.
  209.     dependencies notNil ifTrue:
  210.         [ dependencies do:
  211.         [ :dependent | dependent perform: aSymbol with: anObject ] ]
  212. !!
  213.  
  214.  
  215.  
  216. !Object methodsFor: 'printing'!
  217.  
  218. printString
  219.     | stream |
  220.     stream _ WriteStream on: (String new: 0).
  221.     self printOn: stream.
  222.     ^stream contents
  223. !
  224.  
  225. printOn: aStream
  226.     | article nameString |
  227.     nameString _ self classNameString.
  228.     article _ nameString first isVowel ifTrue: [ 'an ' ] ifFalse: [ 'a ' ].
  229.     article printOn: aStream.
  230.     nameString printOn: aStream
  231. !
  232.  
  233. print
  234.     self printOn: stdout
  235. !
  236.  
  237. printNl
  238.     self print.
  239.     Character nl print
  240. !!
  241.  
  242.  
  243.  
  244. !Object methodsFor: 'storing'!
  245.  
  246. storeString
  247.     | stream |
  248.     stream _ WriteStream on: (String new: 0).
  249.     self storeOn: stream.
  250.     ^stream contents
  251. !
  252.  
  253. storeOn: aStream
  254.     | class hasSemi |
  255.     class _ self class.
  256.     aStream nextPut: $(.
  257.     aStream nextPutAll: self classNameString.
  258.     hasSemi _ false.
  259.     class isVariable
  260.         ifTrue: [ aStream nextPutAll: ' basicNew: '.
  261.               self basicSize printOn: aStream ]
  262.         ifFalse: [ aStream nextPutAll: ' basicNew' ].
  263.     1 to: class instSize do:
  264.         [ :i | aStream nextPutAll: ' instVarAt: '.
  265.            i printOn: aStream.
  266.            aStream nextPutAll: ' put: '.
  267.            (self instVarAt: i) storeOn: aStream.
  268.            aStream nextPut: $;.
  269.            hasSemi _ true ].
  270.     class isVariable ifTrue: 
  271.         [ 1 to: self basicSize do:
  272.         [ :i | aStream nextPutAll: ' basicAt: '.
  273.                i printOn: aStream.
  274.            aStream nextPutAll: ' put: '.
  275.            (self basicAt: i) storeOn: aStream.
  276.            aStream nextPut: $;.
  277.            hasSemi _ true ] ].
  278.     hasSemi ifTrue: [ aStream nextPutAll: ' yourself' ].
  279.     aStream nextPut: $)
  280. !
  281.  
  282. store
  283.     self storeOn: stdout
  284. !
  285.  
  286. storeNl
  287.     self store.
  288.     Character nl print
  289. !!
  290.  
  291.  
  292.  
  293. !Object methodsFor: 'debugging'!
  294.  
  295. inspect
  296.     | class instVars instVal |
  297.     class _ self class.
  298.     instVars _ class instVarNames.
  299.     'An instance of ' print.
  300.     class printNl.
  301.     1 to: instVars size do:
  302.         [ :i | '  ' print.
  303.            (instVars at: i) print.
  304.            ': ' print.
  305.            (self instVarAt: i)  printNl ]
  306. !!
  307.  
  308.  
  309.  
  310. !Object methodsFor: 'private'!
  311.  
  312. classNameString
  313.     | name |
  314.     name _ self class name.
  315.     name isNil
  316.         ifTrue: [ name _ self name , ' class' ].
  317.     ^name
  318.  
  319. !!
  320.  
  321.